home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / heaptrac / heaptrac.exe / TESTHT16.DPR < prev    next >
Text File  |  1996-04-10  |  2KB  |  78 lines
  1. {
  2. // HeapTrace
  3. //   Dynamic memory debugging for Borland Delphi.
  4. //
  5. // ⌐ 1996 Modelistica, Caracas. All rights reserved
  6. //   73000.1064@compuserve.com
  7. }
  8. program TestHT16;
  9. uses
  10.   HeapTrac,
  11.   WinTypes,
  12.   WinProcs,
  13.   Classes,
  14.   SysUtils;
  15.  
  16. { shut down procedures must be declared far }
  17. procedure ShowLogFile; far;
  18. var
  19.    buf :array[0..255] of char;
  20. begin
  21.    if FileExists(HeapTraceDefaultLogFileName) then
  22.       WinExec(StrPCopy(buf, 'NOTEPAD '+ HeapTraceDefaultLogFileName), sw_Show);
  23. end;
  24.  
  25.  
  26. const
  27.    LargeSize = $5FFF;
  28. type
  29.    PTest = ^TTest;
  30.    TTest = array[1..LargeSize] of Byte;
  31.  
  32.    TMyComponent  = class(TComponent);
  33.    TMyList       = class(TList);
  34.    TMyStringList = class(TStringList);
  35.  
  36. var
  37.    O1, O2   :TObject;
  38.    PT, PT2  :PTest;
  39.    P        :Pointer;
  40. begin
  41.    { on shut down routines are called after
  42.      HeapTrace has been removed from the system }
  43.    HeapTraceOnShutDownDo(ShowLogFile);
  44.  
  45.    { the following two are valid but undocumented
  46.      in both Delphi 1.x and Delphi 2.0.
  47.      HeapTrace   wil log them as errors if
  48.      htoIgnoreUndocumented is not set in HeapTraceOptions
  49.      HeapTrace32 will ignore them all the time}
  50.    GetMem(P,    0);
  51.    FreeMem(nil, 0);
  52.  
  53.    O1 := TMyList.Create;
  54.    O2 := TMyComponent.Create(nil);
  55.    O2 := TMyStringList.Create;
  56.    O1.Free;
  57.    O1.Free;                            { ERROR: free an object twice   }
  58.    New(PT);                            { ERROR: this object not freed  }
  59.    New(PT);
  60.    GetMem(PT2, 4321);
  61.    FillChar(PT^, SizeOf(PT^)+1, #1);   { ERROR: memory overrun      }
  62.    Dispose(PT);                        { ERROR: object is invalid   }
  63.    Dispose(PT);                        { ERROR: object freed twice  }
  64.    FreeMem(PT2, 321);                  { ERROR: free incorrect size }
  65.  
  66.    New(PT);                            { ERROR: this object not freed  }
  67.  
  68.    if (HeapTraceAvailableMemory >= SizeOf(TTest))
  69.    or (HeapTraceAvailableMemory = 0) then
  70.      SetHeapTraceAvailableMemory(SizeOf(TTest) div 2);
  71.    try
  72.       New(PT)   { simulated out of memory condition }
  73.    except
  74.    end;
  75. end.
  76.  
  77.  
  78.